'  MAIN.BAS - This module contains the startup procedure, Sub Main(), as
'well as many of the general-purpose application functions and global
'data managment functions.
'
Option Explicit         'require explicit variable declaration
Option Compare Text     'string comparisions will not be case sensitive


'API declarations & constants
Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Global Const HWND_TOP = 0
Global Const SWP_NOSIZE = &H1
Global Const SWP_NOMOVE = &H2


' This structure is used to store the options entered by the user on
'the Options form.
Type utParameters
   iResSelection As Integer   ' Indicates the resource selection.
   dtFrom As Variant          ' The "From:" date & time.
   dtTo As Variant            ' The "To:" date & time.
   bValidated As Integer      ' Indicates if the current values in the
                              'structure have been validated.
   bNew As Integer            ' Indicates if the current values are new.
                              'DisplayTInfoForm() will set this to false the
                              'first time it succesfully runs.
End Type
                              

Type utAssignment
   nAUID As Integer        'unique assignment ID
   nTID As Integer         'task id
   sTName As String        'task name
   nActWork As Integer     'resource actual work
   nRemWork As Integer     'resource remaining work
   dtStart As Variant        'resource start date
   dtFinish As Variant       'resource finish date
End Type


'Module-level variable declarations
Dim mutCurrentParams As utParameters      ' Stores the current set of options parameters from frmOptions.
Dim mbAssignments As Integer              ' Used to indicate that no resources have assignments.

' Returns an index into the assignments collection for a given nTID.  The
'index returned matches the first occurance of the given nRID within the
'assignments collection. If nRID is not in the assignments collection, or
'if there are no assignments, AIndex returns 0.
'
Function AIndex (oAssign As Object, nTID As Integer, nRID As Integer) As Integer
   
   Dim i As Integer
   
   For i = 1 To oAssign.Count
      If oAssign(i).ResourceID = nRID Then
         AIndex = i
         Exit Function
      End If
   Next i
   AIndex = 0
   
End Function

' Takes care of displaying, then unloading, the Splash
'screen.  If bShow is True, then we display the splash
'screen.  If bShow is False, we unload the splash screen.
'
Private Sub DisplaySplash (bShow As Integer)

Dim F As frmSplash
Set F = frmSplash

If bShow = True Then
   'center and display the form
   F.Top = (Screen.Height - F.Height) / 2
   F.Left = (Screen.Width - F.Width) / 2
   F!pnlMain.Caption = CAP_SPLASH1 & Chr$(13) & CAP_SPLASH2
   F.Show MODELESS
Else
   'unload the form - we won't need it again
   Unload F
End If
   

End Sub

'
Sub DisplayTInfoForm ()

   ReDim autAssignments(0) As utAssignment   'the assignments array
   Dim nAssignments As Integer               'number of assignments in the array
   Dim nRID As Integer                       'ID of current resource
   Dim i As Integer
   Dim hWnd%

   On Error GoTo DisplayTInfoFormError
   
   Screen.MousePointer = HOURGLASS
   
   If mutCurrentParams.iResSelection = ALL_RESOURCES Then
      ' If this is the first time through the list for the current
      'resource/date range (bNew = True) then move to the first
      'resource.
      If mutCurrentParams.bNew Then
         mbAssignments = False
         ResourceFirst
      Else
      ' Continue through the list
         ResourceNext
      End If
   Else
      ' If "One Resource" then attempt to move to the indicated resource,
      'or Exit, depending on whether the params are new or not.
      If mutCurrentParams.bNew Then
         ResourceGoto mutCurrentParams.iResSelection
      Else
         ' This resource has already been processed (bNew = False)
         GoTo DTIF_Cleanup    ' Clean up and exit.
      End If
   End If
   
   ' Get the ID of the current resource.
   nRID = CurrentResID()

   ' Fill an array with the task assignments for the current resource.
   nAssignments = nGetResourceAssignments(nRID, autAssignments())

   If nAssignments > 0 Then
      mbAssignments = True                ' Indicate that at least one resource has task assignments.
      mutCurrentParams.bNew = False       ' Indicate that the current parameters have been examined at least once.
      GridReset                           ' Clear the grid.
      For i = 1 To nAssignments
         GridAddRow autAssignments(i)     ' Add the resource's task assignments to the grid.
      Next i
   
      frmTInfo!Grid.Row = 1
      frmTInfo!Grid.Col = ADDWORK
      frmTInfo!Grid.SelEndRow = 1
      frmTInfo!Grid.SelEndCol = ADDWORK
   Else  ' The given resource has no task assignments.
      If mutCurrentParams.iResSelection = ALL_RESOURCES Then
         mutCurrentParams.bNew = False
         DisplayTInfoForm     ' Process the next resource in the list.
      Else  ' One resource was selected from the list.
         Screen.MousePointer = default
         MsgBox MB_NO_VALID_ASSIGNMENTS, MB_ICONINFORMATION, MB_TIMESHEET
         mutCurrentParams.bNew = False
         GoTo DTIF_Cleanup    ' Clean up and exit.
      End If
   End If

   ' Fill in the resource name and date range, then show the task info form.
   frmTInfo!txtEdit.Text = ""
   frmTInfo!pnlName.Caption = CurrentResName()
   frmTInfo!txtAsOf.Text = gdtAsOfDate
   frmTInfo!pnlDateRange.Caption = mutCurrentParams.dtFrom & " - " & mutCurrentParams.dtTo
   Screen.MousePointer = default
   frmTInfo.Caption = CAP_FRM_TINFO & " - " & goActiveProj.Name
   frmTInfo.Show
   frmTInfo!txtAsOf.SetFocus
   frmOptions.Hide
   frmOptions!cmdCancel.Caption = "Close"
   Exit Sub

DisplayTInfoFormError:
   If Err = ERR_EOL And mbAssignments = False Then
      If Not gbDTIF Then
         Beep
         Screen.MousePointer = default
         MsgBox MB_NO_ASSIGNED_RESOURCES, MB_ICONINFORMATION, MB_TIMESHEET
         gbDTIF = True
      End If
   End If

DTIF_Cleanup:
' Cleans up the Task Info form and then displays the Options form.
   frmTInfo!pnlName.Caption = ""
   frmTInfo!pnlDateRange.Caption = ""
   GridReset
   frmTInfo.Hide
   frmOptions.Show
   frmOptions.cmdCancel.SetFocus
   hWnd% = frmOptions.hWnd
   If Not BringToTop(hWnd%) Then TerminateApplication
   Screen.MousePointer = default
   Exit Sub

End Sub

' Updates the progress bar on the "splash" screen
Sub Progress (nPct As Integer, sCaption)
   frmSplash!pnlProgress.FloodPercent = nPct
   frmSplash!pnlActivity.Caption = sCaption
   DoEvents
End Sub

'  Sets goActiveProj to the active project.  Returns true  if
'successful, False if not.  This is the only function that
'directly modifies goActiveProj.
'
Function SetActiveProj () As Integer

Dim oTmp As Object

   On Error GoTo SetModActProjError
   If goProjApp Is Nothing Then
      Error ERR_NO_APP_OBJECT
   Else
   
      If goProjApp.Projects.Count > 0 Then
         Set oTmp = goProjApp.ActiveProject
         If oTmp.Index = 0 Then
            MsgBox MB_CONSOLIDATED_PROJECT, MB_ICONINFORMATION, MB_TIMESHEET
            TerminateApplication
         End If
         If IsPool(oTmp) Then
            Beep
            MsgBox MB_RES_SHARING, MB_ICONEXCLAMATION, MB_TIMESHEET
            TerminateApplication
         End If
         If oTmp.Tasks > 0 Then
            SetActiveProj = True
            Set goActiveProj = oTmp
            Exit Function
         Else
            Beep
            MsgBox MB_NO_TASKS, MB_ICONEXCLAMATION, MB_TIMESHEET
            TerminateApplication
         End If
      Else
         'No projects open.
      End If
   End If
   SetActiveProj = False
   Set goActiveProj = Nothing
   Exit Function

SetModActProjError:
   Select Case Err
      Case 429, 430
         SetActiveProj = False
         Set goActiveProj = Nothing
         Exit Function
      Case 440

      Case Else
         Error Err
   End Select

End Function

Sub SetParameters (iResIndex As Integer, sFromDate As String, sToDate As String)

   Dim dtStart As Variant, dtFinish As Variant
   Dim dtFromDate As Variant, dtToDate As Variant
   Dim dtFromTime As Variant, dtToTime As Variant
   Dim dtFrom As Variant, dtTo As Variant
   Dim D1, D2, D3, D4   'variants

   On Error GoTo SetParamsError

   ' set this flag to false until we've completed validation
   mutCurrentParams.bValidated = False

   ' check the resource selection
   Select Case iResIndex
      Case ALL_RESOURCES
         mutCurrentParams.iResSelection = iResIndex
      Case -1
         Error ERR_NO_RES_SELECTION
      Case Is >= 0
         mutCurrentParams.iResSelection = iResIndex
      Case Else
         Error ERR_BAD_PARAM
   End Select


   ' The line numbers are here to allow the errorhandler to determine
   'exactly which line caused the error, so we can generate the appropriate
   'warning dialog.  If the user enters a date format that VB doesn't
   'recognize, DateValue will generate a runtime error.

1010 dtFromDate = DateValue(sFromDate)
1020 dtToDate = DateValue(sToDate)


   ' if the user didn't enter a time of day with the date, we'll
   'use the default times from the project.
1030 dtFromTime = TimeValue(sFromDate)
   If dtFromTime = 0 Then
      dtFromTime = gdtDefStartTime
   End If
1040 dtToTime = TimeValue(sToDate)
   If dtToTime = 0 Then
      dtToTime = gdtDefFinishTime
   End If

   ' add the dates and times together to get the final parameters
   dtFrom = dtFromDate + dtFromTime
   dtTo = dtToDate + dtToTime

   ' * Validate the date range *
   dtStart = gdtDefStartDate
   dtFinish = gdtDefFinishDate

   ' Is the From: date earlier than the To: date, and is the
   'project start earlier than the project finish?
   If dtFrom <= dtTo And dtStart <= dtFinish Then

      ' Check the From date.
      If dtFrom >= dtStart Then
         If dtFrom <= dtFinish Then
            'Ok
         Else
            dtFrom = dtStart
         End If
      Else
         dtFrom = dtStart
      End If

      ' Check the To date.
      If dtTo <= dtFinish Then
         If dtTo >= dtStart Then
            If dtTo >= dtFrom Then
               'Ok
            Else
               dtTo = dtFinish
            End If
         Else
            dtTo = dtFinish
         End If
      Else
         dtTo = dtFinish
      End If

      ' Make *sure* the To date is still <= the From date
      If dtTo <= dtFrom Then
         'Ok
      Else
         dtTo = dtFinish
         dtFrom = dtStart
      End If

   Else
      ' The dates are in the wrong order - From is not <= To, or Start is not <= Finish
      Error ERR_BAD_DATE_ORDER
   End If

   ' set the current params
   mutCurrentParams.dtFrom = dtFrom
   mutCurrentParams.dtTo = dtTo
   
   ' set the validation flags
   mutCurrentParams.bValidated = True
   mutCurrentParams.bNew = True

   Exit Sub

SetParamsError:
Select Case Err
   Case ERR_BAD_DATE_ORDER
      Error Err
   Case 429 To 440
      Error Err
   Case Else
      Select Case Erl
         Case 1010, 1030
            Error ERR_FROMDATE
         Case 1020, 1040
            Error ERR_TODATE
      End Select
End Select
End Sub

'  This function sets goProjApp to refer to the MSProject Application
'object.  The name is intended to make clear the fact that we're setting
'a module-level variable.
'
'Return values:
'  Success = true
'  Proj not running = 0
'  Proj running, can't get object = 1
'
'
Private Function SetProjApp () As Integer

Dim hWinproj As Integer      'handle to Proj window
Dim bErrRetry As Integer     'indicates a retry at creating an object

'function return value constants
Const PROJNOTRUN = 0
Const PROJNOOBJECT = 1

' Set up error handling
On Error GoTo SetProjAppError
bErrRetry = False                      'init the retry flag used in the error handler

' Get the projapp object.
Set goProjApp = GetObject(, "MSProject.Application")
' Check to be sure we really have an object reference...
If Not (goProjApp Is Nothing) Then
   SetProjApp = True   'Success!
   Exit Function
End If

Exit Function

' Error handling code
SetProjAppError:

Select Case Err
   Case 429    'ole automation server cannot create object
      'try to determine if proj is running...
      hWinproj = FindWindow(FW_WINPROJ, 0&)
      If hWinproj = 0 Then
         SetProjApp = PROJNOTRUN
         Exit Function
      Else
      'proj is running, but we can't create an object
         If Not bErrRetry Then
         'try again
            bErrRetry = True
            Resume
         Else
            SetProjApp = PROJNOOBJECT
            Exit Function
         End If
      End If
   Case Else   'Unanticipated error!
      Error Err
End Select

End Function

'  Timetrak won't work correctly unless the active view is a task view.  This function
'attempts to set the view to one of the standard task views.  Returns True if successful,
'False if not.
Function SetTaskView (bAction As Integer) As Integer

   Dim nView As Integer
   Dim sVName As String
   Const PHONEY_VALUE = "~9~##3##*7@%%1%"     ' A placeholder value that is highly unlikely to correspond to the name of an actual view.

   On Error GoTo SetTaskViewError
   nView = 0
   If bAction = SET_VIEW Then
   ' Store the name of the current active view
5010  gsOrigView = goActiveProj.CurrentView
   If gsOrigView = GANTT_CHART Or gsOrigView = TASK_SHEET Or gsOrigView = PERT_CHART Or gsOrigView = TASK_PERT Then
      SetTaskView = True
      Exit Function
   End If
   ' Now attempt to change the active view to a task view.
SetView:
      Select Case nView
         Case 0
            sVName = GANTT_CHART
         Case 1
            sVName = TASK_SHEET
         Case 2
            sVName = PERT_CHART
         Case 3
            sVName = TASK_PERT
      End Select
5020  goProjApp.ViewApply sVName, True
      SetTaskView = True
   ElseIf bAction = RESTORE_VIEW Then
   ' Attempt to restore the original view, using the view name stored in gsOrigView.
      If gsOrigView <> PHONEY_VALUE Then
5030     'goProjApp.ViewApply gsOrigView, True
         SetTaskView = True
      Else
         SetTaskView = True
      End If
   Else
      SetTaskView = False
   End If
   Exit Function

SetTaskViewError:
   Select Case Erl
      Case 5010   ' Can't obtain the name of the current view.
         gsOrigView = PHONEY_VALUE
         Resume Next
      Case 5020   ' Can't set the requested view, probably because it isn't available.  Try the next view.
         While nView < 4
            nView = nView + 1
            Resume SetView
         Wend
      Case 5030   ' Can't restore the original view.
         Resume Next
      Case Else   ' Unanticipated error.
         '####
   End Select
   SetTaskView = False
   Exit Function

End Function

'  Ensures that AutoSplitTasks = True and AutoTrack = False
'
Function SetWinprojPrefs () As Integer

   On Error GoTo SetWinprojPrefsError

   ' turn off auto-track resources
   If goActiveProj.AutoTrack Then
      goActiveProj.AutoTrack = False
      Beep
      MsgBox MB_AUTOTRACK, MB_ICONINFORMATION, MB_TIMESHEET
   End If
   ' make sure that auto-split tasks is turned on
   If Not goActiveProj.AutoSplitTasks Then
      goActiveProj.AutoSplitTasks = True
   End If
   ' turn off the display of scheduling messages
   If goProjApp.DisplayScheduleMessages = True Then
      goProjApp.DisplayScheduleMessages = False
      gbSchedMsg = True   'set a flag so we'll know to turn scheduling messages back on when we terminate
   Else
      gbSchedMsg = False
   End If
   SetWinprojPrefs = True

   Exit Function

SetWinprojPrefsError:
   SetWinprojPrefs = False
   Exit Function

End Function

'  This routine is responsible for terminating the Timesheet app in
'a graceful way.
'
Sub TerminateApplication ()

   Dim bRtn As Integer

   ' Restore the default mouse pointer.
   Screen.MousePointer = default
   ' Turn the display of scheduling error messages back on.
   If gbSchedMsg Then goProjApp.DisplayScheduleMessages = True
   ' Try to restore the original view.
   bRtn = SetTaskView(RESTORE_VIEW)
   End

End Sub

'  Brings the window identifed by hWnd to the top of the window
'z-order.  Used to make sure that the Options dialog hasn't inadvertently
'been hidden behind other windows.
'Returns True if successful, False if not.
Function BringToTop (hWnd As Integer) As Integer

   Dim rtn%

   rtn% = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE)

   If rtn% <> 0 Then
      BringToTop = True
   Else
      BringToTop = False
   End If

End Function

' Filters each task according to the following criteria:
'    - The task must be in progress at some point during the date range;
'    - The task is not 100% complete (Actual Finish = N/A);
'    - The task is not a summary or milestone.
'    - The task is not a subproject task.
'
' If the task meets all the criteria, the function returns True; if not,
'returns False.
'
Function bTaskFilter (nTID As Integer) As Integer
   
   Dim df As Variant    'date range "from" date & time
   Dim Dt As Variant    'date range "to" date & time
   Dim Ts As Variant    'task sched. start
   Dim tf As Variant    'task sched. finish
   Dim Taf As Variant   'task actual finish
   Dim oTask As Object  'the task object

   On Error GoTo bTaskFilterError
   
   df = mutCurrentParams.dtFrom
   Dt = mutCurrentParams.dtTo

   Set oTask = goActiveProj.Tasks(nTID)

   ' First, check to see if the task has finished.
   Taf = oTask.ActualFinish
   If IsDate(Taf) Then
      bTaskFilter = False
      Exit Function
   End If

   ' Now check to see if the task falls within the date range.
   Ts = oTask.Start
   tf = oTask.Finish
   If tf >= df Then
      If Ts <= Dt Then
         ' The task does fall within the date range.
      Else
         ' Task occurs entirely after the date range.
         bTaskFilter = False
         Exit Function
      End If
   Else
      ' Task occurs entirely before the date range.
      bTaskFilter = False
      Exit Function
   End If

   ' Now check to see if the task is a milestone.
   If oTask.Milestone Then
      bTaskFilter = False
      Exit Function
   End If
   
   ' Check to see if the task is a subproject task.
   If oTask.Subproject <> "" Then
      bTaskFilter = False
      Exit Function
   End If

   ' Finally, check to see if the task is a summary task.
   If oTask.Summary Then
      bTaskFilter = False
      Exit Function
   End If

   ' The task passed all the checks; it meets the criteria.
   bTaskFilter = True
   
Exit Function

bTaskFilterError:
   bTaskFilter = False
   Exit Function

End Function

'
'  Sets the global variables that are used to identify the default work
'and duration units used by the current active project.
'
Sub GetProjDefUnits ()

   Dim D$, W$
   
   ' Get the time separator character from Proj.
   gsTimeSep = goProjApp.TimeSeparator

   
  ' Default duration unit.  gsDefDurUnits is the string representation ( "m", "h", etc),
   'and gnDefDurUnit is the integer representation (what proj uses).
   gnDefDurUnit = goActiveProj.DefaultDurationUnits
   Select Case gnDefDurUnit
      Case pjMinutes
         D$ = DUR_MINUTES
      Case pjHours
         D$ = DUR_HOURS
      Case pjDays
         D$ = DUR_DAYS
      Case pjWeeks
         D$ = DUR_WEEKS
      Case pjElapsedMinutes
         D$ = EDUR_MINUTES
      Case pjElapsedHours
         D$ = EDUR_HOURS
      Case pjElapsedDays
         D$ = EDUR_DAYS
      Case pjElapsedWeeks
         D$ = EDUR_WEEKS
   End Select
   gsDefDurUnit = D$

   ' Default work unit.
   gnDefWorkUnit = goActiveProj.DefaultWorkUnits
   Select Case gnDefWorkUnit
      Case pjMinutes
         W$ = DUR_MINUTES
      Case pjHours
         W$ = DUR_HOURS
      Case pjDays
         W$ = DUR_DAYS
      Case pjWeeks
         W$ = DUR_WEEKS
      Case pjElapsedMinutes
         W$ = EDUR_MINUTES
      Case pjElapsedHours
         W$ = EDUR_HOURS
      Case pjElapsedDays
         W$ = EDUR_DAYS
      Case pjElapsedWeeks
         W$ = EDUR_WEEKS
   End Select
   gsDefWorkUnit = W$

End Sub

' Gets the default start and finish dates & times for the active project.
Sub GetProjStartFinishDates ()

Dim dtPSumStart, dtPSumFinish
Dim dtPStart, dtPFinish
Dim nMinPerDay As Integer

'  Get the default start and finish times.
   gdtDefStartTime = goActiveProj.DefaultStartTime
   gdtDefFinishTime = goActiveProj.DefaultFinishTime
   
' Get the project start and finish date/time (based on the project summary task)
   If Not goActiveProj.DisplayProjectSummaryTask Then
      goActiveProj.DisplayProjectSummaryTask = True
      goProjApp.SelectBeginning
      dtPSumStart = goProjApp.ActiveSelection.Tasks(1).Start
      dtPSumFinish = goProjApp.ActiveSelection.Tasks(1).Finish
      goActiveProj.DisplayProjectSummaryTask = False
   Else
      goProjApp.SelectBeginning
      dtPSumStart = goProjApp.ActiveSelection.Tasks(1).Start
      dtPSumFinish = goProjApp.ActiveSelection.Tasks(1).Finish
   End If
   
'  Get the start and finish dates based on the project start and finish -
'which might very well be different from the project summary task
'start and finish.
   dtPStart = goActiveProj.ProjectStart
   dtPFinish = goActiveProj.ProjectFinish

   
' Now compare the proj start/finish to the projsummary start/finish.
   If dtPSumStart < dtPStart Then
      gdtDefStartDate = dtPSumStart
   Else
      gdtDefStartDate = dtPStart
   End If
   If dtPFinish < dtPSumFinish Then
      gdtDefFinishDate = dtPSumFinish
   Else
      gdtDefFinishDate = dtPFinish
   End If

' Get the proj current date and today's actual date.
   gdtCurrentDate = goActiveProj.CurrentDate
   gdtAsOfDate = gdtCurrentDate
   gdtTodaysDate = Date + gdtDefFinishTime

' This next block of code prevents a situation where the app assigns a
'to: date that is earlier than the from: date.  This could happen if the
'project start date was in the future, or if the project started at a
'time that is after the normal task finish time.
   If gdtDefStartDate > gdtTodaysDate Then
      gdtTodaysDate = Int(gdtDefStartDate) + gdtDefFinishTime
      If gdtDefStartDate > gdtTodaysDate Then
         gdtTodaysDate = gdtDefFinishDate
      End If
   End If

End Sub

Function IsPool (oProject As Object) As Integer

Dim sPool As String

   On Error GoTo IsPoolError
   sPool = oProject.ResourcePoolName
   If sPool <> oProject.Name Then
      If sPool <> oProject.FullName Then
         IsPool = True
         Exit Function
      End If
   End If
   goProjApp.ResourceSharingPoolAction 1
   IsPool = True
   Exit Function
   
IsPoolError:
   If Err = 440 Then
      IsPool = False
   Else
      Error Err
   End If
   Exit Function

End Function

' This is the main startup routine for the application.
'
Sub Main ()

   Dim nSetModPA As Integer, nRes As Integer, bInitRL As Integer
   Dim bSetModActP As Integer, hInst As Integer, nRet As Integer
   Dim bRtn As Integer
   Dim n As Integer

   On Error GoTo SubMainError
   If Command$ = "/d" Then gbDbg = True
   
   If App.PrevInstance Then
      Beep
      MsgBox MB_PREVINSTANCE, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
      TerminateApplication
   End If

   Screen.MousePointer = HOURGLASS

'  Display the splash screen during intialization
   DisplaySplash True
   DoEvents 'ensures that the splash screen will get a chance to repaint
   Progress 2, PROG_INIT
   
'  Get a Proj application object.
   nSetModPA = SetProjApp()
   If nSetModPA = True Then
      'goProjApp.ViewApply "Gantt Chart", True
   ElseIf nSetModPA = 0 Then 'Proj isn't running
      MsgBox MB_PROJ_NOT_RUNNING, MB_ICONEXCLAMATION, MB_TIMESHEET
      TerminateApplication
   ElseIf nSetModPA = 1 Then 'Can't get an app object
      MsgBox MB_CANNOT_CREATE_OBJECT, MB_ICONEXCLAMATION, MB_TIMESHEET
      TerminateApplication
   Else  'Unanticipated return value - generate an error.
      Error nSetModPA
   End If
   Progress 13, PROG_INIT

'  Get a reference to the active project
   If Not SetActiveProj() Then
      MsgBox MB_NO_OPEN_PROJECTS, MB_ICONEXCLAMATION, MB_TIMESHEET
      TerminateApplication
   End If
   Progress 17, PROG_INIT

' Make sure that the active view is a task view.
   bRtn = SetTaskView(SET_VIEW)
   If bRtn = False Then
      Beep
      MsgBox MB_NO_TASK_VIEW, MB_ICONEXCLAMATION, MB_TIMESHEET
      TerminateApplication
   End If

   GetProjStartFinishDates

'  Get the default units for work and duration from the current project.
   GetProjDefUnits
   Progress 20, PROG_INIT

'  Then we initialize the resource list.
   If Not InitResourceList(goActiveProj) Then
      ' If InitResourceList returns false, it is reasonable to assume
      '(given all the other checks we've made) that none of the
      'resources in the project have task assignments.
      MsgBox MB_NO_ASSIGNED_RESOURCES, MB_ICONEXCLAMATION, MB_TIMESHEET
      TerminateApplication
   End If
   Progress 95, PROG_FORMLOAD

'  Ensure that autotrack resources is turned off and autosplit tasks
'is turned on.
   bRtn = SetWinprojPrefs()

' Load (but don't display) application forms.
   Load frmOptions
   Load frmTInfo
   Progress 100, PROG_DONE

' Remove the splash screen.
   DisplaySplash False

' Display the Options form.
   Screen.MousePointer = default
   frmOptions!txtFrom.Text = gdtDefStartDate
   frmOptions!txtTo.Text = gdtTodaysDate
   frmOptions.Caption = CAP_FRM_OPTIONS
   frmOptions.Show MODELESS

Exit Sub


SubMainError:
   Screen.MousePointer = default
   If gbDbg Then MsgBox "SubMain: Error " & Err & " : " & Error$, MB_ICONSTOP, MB_TIMESHEET
   Beep
   MsgBox MB_GENERIC_ERROR, MB_ICONEXCLAMATION, MB_TIMESHEET
   TerminateApplication

End Sub

' Gets the task assignments for a given resource ID.  The assignments
'are returned in the autAssignments() array.  This function alters the
'autAssignments array by redimensioning it.  nGetResourceAssignments returns
'the count of assignments placed in the autAssignments() array.
'
Function nGetResourceAssignments (nRID As Integer, autAssignments() As utAssignment) As Integer
   
   Dim oRes As Object      'Current resource.
   Dim oAssign As Object   'Assignments for the current resource.
   Dim oTask As Object
   Dim i As Integer, nTID As Integer, nCount As Integer
   Dim oTAssign As Object
   On Error GoTo nGetResAssignError
   nCount = 0
   Set oAssign = goActiveProj.Resources(nRID).Assignments
   'Set oAssign = oRes.Assignments
   For i = 1 To oAssign.Count
      Set oTask = oAssign(i)
      nTID = oTask.TaskID
      ' bTaskFilter checks the task to make sure it meets the criteria
      'for inclusion in the assignments array.
      If bTaskFilter(nTID) Then
         ReDim Preserve autAssignments(nCount + 1)
         Set oTAssign = goActiveProj.Tasks(nTID).Assignments
         autAssignments(nCount + 1).nAUID = AIndex(oTAssign, nTID, nRID)
         autAssignments(nCount + 1).nTID = nTID
         autAssignments(nCount + 1).sTName = oTask.TaskName
         autAssignments(nCount + 1).nActWork = oTask.ActualWork
         autAssignments(nCount + 1).nRemWork = oTask.RemainingWork
         autAssignments(nCount + 1).dtStart = oTask.Start
         autAssignments(nCount + 1).dtFinish = oTask.Finish
         nCount = nCount + 1
      End If
   Next i
   nGetResourceAssignments = nCount
   
Exit Function

nGetResAssignError:
   nGetResourceAssignments = 0
   Exit Function

End Function

